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This document is a description of a number of routines which have been 
written to provide limited but useful runtime support for BCPL programs. 
In most cases, the routines are very similar to the ALGOL and FORTRAN 
counterparts or to the actual assembly language DOS system call. Routines 
have been written to do many I/O functions and a few string functions. 
Limited formatted I/O functions have been implemented using general string 
integer conversion routines. 

Before calling any of the I/O runtime routines, the routine initbcplio(l) 
must be called to set up several global variables. The I/O errors are 
handled by the routine whose address is in syserror . This routine is 
normally ioerror , a routine which corrects some inadequacies of the DOS 
error-handling facility, and optionally prints procedure level information. 
Input routines do not consider end of file to be an error and return this 
information through a byte count indicating how many bytes were actually 
read, or a special ASCII character. Errors may be captured by changing 
the routine in syserror to one of the user's routines or by setting syserror- 
trap to "false". If this is done, after an I/O routine is called, 
the location syserrorf lag will be false if no error has occurred, but 
otherwise will be true; s yserrorvalue will have the error value from AC2 
after the DOS system call. End of file will be shown as an error when 
this facility is used. For doing routine tasks, the default error routine 
will usually be adequate. 

DOS strings are not compatible with BCPO strings. All the I/O routines 
accept BCPL strings and convert them to DOS strings when necessary, with 
the exception of readline and writeline as described for those two procedures. 
Again, for routine tasks, string incompatibility is of no consequence. 

This document is intended to be updatable and is organized in a way to make 
this process easier; all global variables are described in section II, all 
procedures are described in the following section III, and an index will be 
attached listing all names in sections II and III. When updates are made, 
sheets ^belonging to section III will be issued along with a new index. The 
index will carry names in alphabetical order with mnemonic arguments shown, 
so that in many cases the index will answer questions about a given procedure. 
The procedure descriptions will, in many cases, carry a cross-reference note 
to the DOS manual of the form DOS:ch-pp. In general, all procedure arguments 
must be specified but in a few specif ic cases , missing arguments will cause 
default assignments as noted by specific procedure descriptions — arguments 
which are optional are delineated by brackets!]. 
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sysac 

The accumulators used for system calls to DOS. Not generally useful 
except inside the runtime routines. 

syserrorflag 

If set after a system call, an error has occured. This will be true 
independent of the state of syserrortrap. The value of the error will 
be in syserrorvalue until another error occurs. 

syserrorvalue 

If syserrorflag is set after a system call, this static contains the 
value of the error. The value is constant until another error occurs. 

syserrortrap 

If this static is set to true, the routine ioerror will print an 
appropriate error message and return to DOS CLI. If set to false, 
ioerror will simply return. If ioerror is cal led by the user program 
with a single parameter, ioerror behaves as if syserrortrap were set 
to true. For more information see ioerror(syserrorvalue). 

sysprintpc 

If set to true, ioerror will print the addresses of the system 
procedure from the runtime I/O and the user procedure which caused 
the error. This is the variable which is set to true by initbcpl io(2) . 

f il enamel ength 

The maximum length of DOS filenames—manifest constant which may be 
used for allocating vectors to receive DOS file names. 
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nbytes = readcomcm(chno, string [, switches]) 

Purpose: 

To read arguments and switches from the DOS command file, COM. CM 
Parameters: 
chno 

DOS channel number, previously opened to file COM. CM 
string 

A BCPL vector for the name read from COM. CM (may be allocated 
with vec f ilenamelength). 
switches 

A 26 element .boolean vector in which each element corresponds to 
the alphabetic character for the switch. 
Function Results: 
nbytes 

The number of bytes actually read is returned. 

Inltbcplio(mode) 

Purpose: 

To initialize various constants needed by the runtime I/O routines. 
Failure to invoke this routine will lead to system crashes at 

undefined times! 
Parameters: 

mode 

1 - normal mode. Error messages will be given normally. 

2 - diagnostic mode. Stack information will be printed if this 
mode is set. Mode 2 mayalso be invoked by setting sysprlntpc to 
true. 

char s readch(chno) ... 

Purpose: 

To read one 8 bit character from channel chno previously opened to 
a DOS file. 
Parameters: 
chno 

A DOS channel number 0-7. 
Function Results: 
char 

The 8 bit character read from the channel. 

wri tech (chno, char) 

Purpose: 

To write one 8 bit character from channel chno previously opened to 
a DOS file. 
Parameters: 
chno 

A DOS channel number 0-7. 
char 

The 8 bit character to be written. 



nbytes = readseq(chno, bytepointer, nbytes) DOS: 4- 14 
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Purpose: 

Read a number of bytes using the DOS .RDS command. 
Parameters: 
chno 

A DOS channel number 0-7. 
bytepo inter 

DOS byte pointer to the first byte involved in the transfer, 
nbytes 

Number of bytes to be read. 
Function Results: 
nbytes 

Number of bytes actually read— must be used to detect end of 
file. 



writeseq(chno, bytepointer, nbytes) D0S:4-18 

Purpose: 

Write a number of bytes using the DOS .WRS command. 
Parameters: 
chno 

A DOS channel number 0-7. 
bytepointer 

DOS byte pointer to the first byte involved in the transfer, 
nbytes 

Number of bytes to be written. 



nbytes = readl ine(chno, string[, true/false]) D0S:4-13 

Purpose: 

To read a string terminated by a carraige return from a DOS file. 
Parameters: 

chno j 

A DOS channel number 0-7. 

string 

A BCPL vector with enough space to receive the input string. 

true/false 

If true, the TRUE DOS readline function is executed. The .RDL 
function terminates on NULL as well as form feed, carraige 
return and end of file. One usually does not want to deal with 
this function. If false or absent, the NULL termination is 
removed. 
Function Results: 

nbytes 

If 1, a terminator has been received. The last character in the 
string received is either carraige return or form feed (or NULL 
if. the true .RDL) or carraige return followed by #377 if end of 
file. 



wrtteline(chno, string) DOS:4-17 

Purpose: 

Write a string which MUST be terminated by a carraige return, null 

or form feed to the DOS channel previously opened. DOS interprets 

tabs, form feeds for certain devices. 
Parameters: 

chno 
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A DOS channel number 0-7. 
string 

A BCPL string or vector which must be terminated as specified 
above. 



wr1testr(chno, string) 

Purpose: 

Write any BCPL string. A line feed Is unconditionally Issued 
following every carraige return character. 
Parameters: 
chno 

A DOS channel number 0-7. 
string 

A BCPL string or vector which must be terminated as specified 
above. 



writezoct(chno, number) 

Purpose: 

Write a six digit unsigned octal number with leading zeroes. 
Parameters: 
chno 

A DOS channel number 0-7. 
number 

16 bit quantity. 



writedec(chno, number[, space]) 

Purpose: 

Write a signed decimal number with fixed or variable spacing. 
Parameters: 
chno 

A DOS channel number 0-7. 
number 

16 bit quantity, 
space 

Number of spaces to be used. If missing or zero, a variable 

number of spaces are used. 



writeoct(chno, number[, space]) 

Purpose": 

Write a signed octal number with fixed or variable spacing. 
Parameters: 
chno 

A DOS channel number 0-7. 
number 

16 bit quantity, 
space 

number of spaces to be used. If missing or zero, a variable 

number of spaces are used. 
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writeform(chno, formatcode, data[, formatcode, data ...]) 

Purpose: 

Write a group of string or 16 bit data to the channel as specified 
by the formatcodes. 
Parameters: 
chno 

A DOS channel number 0-7. 
formatcode 

- data following is string data. 

2-10 - data following is a 16 bit quantity to be displayed in 

that radix. 



writevalue(chno, number, rdx[, space]) 

Purpose: 

Write a 16 bit signed number in arbitrary radix (2-10) using fixed 
or variable spacing. 
Parameters: 
chno 

A DOS channel number 0-7. 
number 

A 16 bit signed quantity, 
rdx 

An arbitrary radix 2-10. 
space 

The number of spaces to be used. If the argument Is missing or 

0, a variable number of spaces will be used. 



word = readbin(chno) 

Purpose: 

Read a 16 bit quantity from the DOS channel. No end of file 

detection is provided except by capturing the error with 

syserrortrap. 
Parameters: 

chno 

A DOS channel number 0-7. 
Function Results: 

word 

A 16 bit quantity read from the file. 



writebin(chno, word) 
..»'■'' 
Purpose: 

Write a 16 bit quantity to the specified channel. 
Parameters: 
chno 

A DOS channel number 0-7. 
word 

A 16 bit quantity to be written. 
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chno = opon(namo) DOS:4-10 

Purpose: 

Open a DOS file to a channel selected by the runtime routines. 
Parameters: 
name 

Any BCPL string which is a legal DOS file name. Device 
specifier must be upper case, e.g., DP0--a11 other characters 
are translated to upper case. 
Function Results: 
chno 

A DOS channel number 0-7 returned specifying the channel number 
to be used. 



chno = append(name) DOS:4-ll 

■ . ■ . .■ ■■ (....■■;.. 

Purpose: 

Re-open a DOS file to a channel selected by the runtime routines. 
Writing will begin following the last character In the existing 
file. 
Parameters: 
name 

Any BCPL string which Is a legal DOS file name. Device 
specifier must be upper case, e.g., DPO — all other characters 
are translated to upper case. 
Function Results: 
chno 

A DOS channel number 0-7 returned specifying the channel number 
to be used. 



nbytes = curpos(chno) 

Purpose: 

Return the current byte position of a DOS file- 
Parameters: 
chno 

A DOS channel 0-7. 
Function Results: 
nbytes 

Current byte pointer for the file. 



setpos(chno, nbytes) 

Purpose: 

Set the current byte position of a DOS file. 
Parameters : 
chno 

DOS channel 0-7. 
nbytes 

Current byte pointer for the file. 



cur posdw( chno, doublewordvector) 
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Purpose: 

Return the current block and byte number of a DOS file in a BCPL 
vector to overcome the lack of double precision Integers In BCPL. 
Parameters: 
chno 

A DOS channel 0-7. 
doublewordvector • 

A 2 word BCPL vector giving the block number in word and the 
byte number in word 1. 



setposdw(chno, doublewordvector) 

Purpose: 

Set the current block and byte number of a DOS file in a BCPL 
vector to overcome the lack of double precision Integers in BCPL. 
Parameters: 
chno 

A DOS channel 0-7. 
doublewordvector 

A 2 word BCPL vector giving the block number in word and the 
byte number in word 1. 



createf ile(name) DOS:4-6 

Purpose: 

Create a DOS file. 
Parameters: 

name 

A legal DOS file name. 



deletef ile(name) DOS:4-7 

Purpose: 

Delete a DOS file. 
Parameters: 

name 

A legal DOS file name. 



initdev(name) DOS-.4-4 

Purpose: 

Initialize a DOS device. 
Parameters: 

name 

A legal DOS device name. 



dlrectorydev(name) D0S:4-4 

Purpose: 

Change the default directory to the indicated device 
Parameters: 

name 

A legal DOS device name. 
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releasedev(name) DOS:4-5 

Purpose: 
Parameters: 
name 

A legal DOS device name. 

renamef i 1e(name,newname) D0S:4-7 

Purpose: 

Change the name of an existing DOS file. 
Parameters: 

name 

A legal DOS file name. 

close(chno) D0S:4-12 

Purpose: 

Close an I/O channel to further use until re-opened. 
Parameters: 

A legal DOS channel number (0-7). 

resetf11es() DOS:4-13 

Purpose: 

Close all I/O channels to further use until re-opened. 
Parameters: 

A legal DOS channel number (0-7). 

errvalue = systemca11(ac0, acl, ac2, syscallname, err) D0S:4-1 

Purpose: 

Generate a DOS system call directly. 
Parameters: 
acO 

NOVA ac to be passed as part of the system call, 
acl 

Nova ac 1. 
ac2 

Nova ac 2. 
syscal Iname 

a name from the list of system calls contained in lox, 

generally, the DOS mnenmonic preceded by "sys"--e.g., sysrdl for 

.RDL. 
err'" 

The BCPL procedure to be called in the event of an error return 

from the system call. 
Function Results: 
err 

The error value if an error occurs, otherwise -i. The error 

code is returned in global vector SYSACI2 and in the global 

variables syserrorflag and syserrorvalue. If syserrorflag 1s 

set, syserrorvalue contains the value of the error. 

syserrorvalue will not be* changed. If there is no error but 
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sysac!2 will be changed with every system call. 

1oerror(syscal Iname, sysac) or (syserrorvalue) 

Purpose: 

Writes an error message to the teletype output device. Most 
messages are generated by DOS, but in a few cases, ioerror 
generates the correct message. If called with 2 parameters, the 
error value is taken from the vector specified by sysac and in some 
cases the name specified by sysac. If called with 1 parameter, the 
error value is taken to be the value of that parameter and if 
needed syserrorname will be used. If syserrortrap is set to false, 
this routine will simply return when called with TWO parameters. 
The routine is executed unconditionally if called with only one 
parameter. 
Parameters: 
syscal lname 

The DOS system call used to generate the error, 
syac 

The system call accumulator vector, 
syserrorvalue 

The error value which may be given directly in lieu of the two 

above. 

Install (chno) DOS:4-5 

Purpose: 

Install a DOS on the default directory device. 
Parameters: 

chno 

The DOS channel previously opened to the DOS to be Installed. 

chatr(chno, acO) D0S:4-8 

Purpose: 

Change the attributes of a DOS file. 
Parameters: 
chno 

A DOS channel previously opened to the file to be changed. 
acO 

The value for acO as specified in the DOS manual for file 
attributes. 

R=#100000 . 

S=#020000 
P=#000002 
W=#000001 
WARNING!!!!! if #040000 (bit 1) is set and the file is 
permanent, it cannot be removed except by a full Initialization 
of the directory!!!!!!!!! 

acO = getf ileatr(chno) D0S:4-9 

Purpose: 

Returns the attributes of a DOS file. 
Parameters: 

chno 
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A DOS channel previously opened to the file 1n question. 
Function Results: 
acO 

The word returned with meanings defined by the DOS manual. 

incr = memavailO DOS:4-21 

Purpose: 

Returns the amount of available memory for the user program. 
Function Results: 

Incr 

The increment of available memory. 

memincr(incr) DOS:4-21 

Purpose: 

Change the amount of user available memory. 
Parameters: 

Incr 

The increment of memory to be claimed. 

dosexec(name, acl) D0S:4-23 

Purpose: 

Execute a DOS save file. 
Parameters: 

name 

The name of a DOS save file to be executed. 

acl 

The value for acl as specified by the DOS manual. If missing, 
will be used so that the current execution level is pushed to 
the disk and the next save file will be started at its normal 
starting address. 

dosreturn() D0S:4-24 

Purpose: 

Return control to DOS CLI . 

dosereturn(ac2) D0S:4-24 

Purpose: 

Return control to DOS giving an error code. The common error 
messages will be misprinted due to DOS assumptions about file names. 

Parameters: 
ac2 ..-" 

The error value to be returned. 

dosbreak() DOS-.4-25 

Purpose: 

Create the file BREAK. SV. WARMING!!!! All I/O channels must be 
closed with a resetfiles command if the file is to be re-executed. 
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word = strtovalue(string[, radix]) 

Purpose: 

Convert a signed string to a 16 bit integer in the specified radix* 
Parameters: 
string 

The BCPL string to be converted, 
radix 

The radix of the conversion. If unspecified, 8 is assumed. 
Function Results: 
word 

A 16 bit word having the converted value. 

valuetostr(word, string, rad1x[, space]) 

Purpose: 

Convert a 16 bit signed value to a signed string with no leading 

zeros having either fixed or variable spcing. 
Parameters: 

word 

The 16 bit value to be converted. 

string 

A vector with enough space to hold the converted value. If 
fixed spacing is specif ied, overflow will cause more spaces to 
be used in this vector. The maximum number of spaces used 
depends on the radix and is 16 for radix 2, 6 for radices 8 and 
10. 

radix 

The conversion radix. 

space 

The number of string spaces to be used. If zero or missing, 
variable space is assumed. 

packstr(ustring, pstring) 

Purpose: 

Change a BCPL string from unpacked format (one byte per word) to 
packed format (two bytes per word). 
Parameters: 
ustring 

A vector containing a BCPL unpacked string, one character per 
word, the first word specifying the length, 
pstring 

A vector with enough room to receive the packed string. 

unpackstr(pstring, ustring) 

Purpose^ 

Change a BCPL string from packed format (two bytes per word) to 
unpacked format (one byte per word). 
Parameters: 
pstring 

A BCPL string, 
ustring 

A vector with enough room for the BCPL unpacked string, one 
character per word, the first word specifying the length. 
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movestr(stringsrc, stringdest) 

Purpose: 

Move a BCPL string which may be in either packed or unpacked format, 
Parameters: 
stringsrc 

A BCPL string to be moved, 
stringdest 

A vector with sufficient room to receive the source string. 

byteptr = dostr(bcplstring, dosstring) 

Purpose: 

Convert a BCPL string to a DOS string. 
Parameters: 
bcpl string 

A BCPL string to be converted, 
dosstring 

A vector with sufficient space to receive the converted string. 
The only difference in the two formats is that DOS requires a 
null character at the end of many strings. 
Function Results: 
byteptr 

A DOS byte pointer to the first character of the DOS string. 

word = lengthstr(string) 

Purpose: 

Return the length of a BCPL string. :- 

Parameters: 
string 

A BCPL string. 
Function Results: 
word 

The length of the string/ 

char = extractchar(string, index) 

Purpose: 

Extract a single character from a string at a specified index. 
Parameters : 
string 

A BCPL string, 
index 

The index for the character. If out of range, garbage is 
returned. 
Function Results: 
char 

A 16 bit word containing the value of the character. 

lengthstringl = extractstr(stringl, string2, index, lengthstringl) 

Purpose: 

Extract string 1 from string 2 beginning at the specified index 
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Parameters: 
stringl 

A vector of sufficient size to receive the extracted string. 
string2 

The string from which the extraction is to be made, 
index 

The beginning index for extraction; If the index goes out of 

the range of string2 at any time, the length of the extracted 

string will be adjusted accordingly, 
lengthstrl 

The length of the string to be extracted. 
Function Results: 
lengthstrl 

The actual length of the extracted string. 

lastbyteindex = imbedchar(char, string[, Index]) 

Purpose: 

Imbed a character Into a vector containing a BCPL string. The 
existing character at that index is destroyed. If the Index for 
the imbedded character is greater than the length of the string, 
the second string is filled with blanks up to the imbedded 
character. If no index is specified, the character wl 11 be 
appended. 
Parameters: 
char 

The character to be imbedded. 
strlngZ 

A vector or BCPL string in which the character is to be 

Imbedded. If index extends the length of string2, string2 must 

be a vector large enough to hold the results, 
index 

The index in string2 at which the character is to be imbedded. 
Function Results: 
lastbyteindex 

The last position of string2 which was modified. 

lastbyteindex = imbedstr(stringl, string2[, index]) 

Purpose: 

Imbed stringl in string2. The existing sub-string at that Index Is 
destroyed. If the index for the imbedded stringl is greater than 
the length of the string2, string2 is fil led with blanks up to the 
imbedded character. If no index is specified, stringl wl 1 1 be 
appended to string 2. 
Parameters: 
stringl 

The string to be imbedded. 
string2 

A^. vector or BCPL string in which the first string Is to be 

imbedded. If stringl extends the length of string2, string2 

must be a vector large enough to hold the results. 
Index 

The index in string2 at which stringl is to be Imbedded, 
lastbyteindex 

The index of the last byte Imbedded in string2. 
Function Results: 
lastbyteindex 



SECTION III .3-13 

The last position of string2 which was modified. 

Index = searchstr(stringl f string2[, startlndex]) 

Purpose: 

Search stringl for string2 at the specified starting Index or at 
the start of stringl. 
Parameters: 
stringl 

The string to be searched. 
string2 

The string to be found, 
start index 

The index in stringl at which to begin the search. 
Function Results: 
Index 

The index of the string if 1t Is found; if not, then -1. 
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// BCPL runtime -- global definitions 

// DOS system definitions 

manifest [ 

sysgchar = #67400 
syspchar ■ #70000 
sysopen ■ #74077 
sysappend = #72477 
sysclose - #74477 
syscreate = #60000 
sysdelete = #60400 
sysrds = #75077 
syswrs «* #76477 
sysrdl = #75477 
syswrl » #77077 
sysinit = #64000 
sysdir » #63000 
sysrlse = #62400 
syslnst = #71477 
sysrename = #61000 
syschatr = #73077 
sysgtatr = #73477 
sysreset = #65000 
sysmem = #61400 
sysmemi « #71000 
sysexec » #63400 
sysrtn = #64400 
sysertn * #66400 
sysbreak » #62000 



// various constants 

manifest £ 

f llenamelength a 20 

] 

external [ 

// static variables 

syscall 

syserror 

sysac 

syserrorflag 

syserrortrap 

syserrorvalue 

sysprintpc 

// procedures 

readcomcm 

Initbcplio 

noargs 

readch 

writech 

readseq -" 

writeseq 

readline 

wMtellne 

wrltestr 

writezoct 

readbin 

writebin 

createfile 

open 

append 

close 

curpos 



curposdw 

setpos 

setposdw 

systemcall 

loerror 

deleteMle 

inltdev 

directorydev 

releasedev 

renamef ile 

chatr 

getfileatr 

getdevatr 

resetfiles 

memavail 

memlncr 

dosexec 

dosreturn 

dosereturn 

dosbreak 



// string procedures 

external [ 

lengthstr 

extractchar 

searchstr 

extractstr 

Imbedstr 

Imbedchar 

packstr 

movestr 

unpackstr 

strtovalue 

valuetostr 

writedec 

writeoct 

writeform 

wrltevalue 

3 
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// BCPL I/O and Runtime 

get "1ox M 

static [ • 

syscall o nil //dos system call procedure 

syserror = nil //dos system error proccdursysac = nil 

sysac o nil //dos system call acs 

sysprintpc » nil //determines runtime error procedure address printout 

syserrorpc = nil //system address for print routine 

usererrorpc «= nil //user address for print routine 

syserrorflog = nil //user error response flag 

syserrortrap = nil //user error control flag 

syserrorvalue* nil //error value 

syserrorname = nil //error name for ioerror 

3 

let readcomcm(chno, name, sw) be 

C //read the next name and switch list from com. cm 

//switches are returned in a 26 element boolean vector 
//iff sw is present. 
let 1 » readline( chno, name, true); namelO ..» name!0 -. #400 
1f 1 eq then C namc!0 = 0; return ] 

let s,j, three = nil ,0,noargs( ) eq 3 
for k h 1 to 4 do 
C s * readch(chno) 

1f three then for 1 = 1 to 8 do 
C sw!j ».(s & #200) ne 
if j ge 25 then break 
j»j+l; s =« s lshift 1 



] 



3 



and initbcpl io(arg) be 

C syscal 1 = rv #360 

sysac - rv #362 //init system nc pointer for dos system calls 

syserror = ioerror //new error processor 

sysprintpc = arg eq 2 //set procedure address print to true 

//1f argument of init call is 2 
syserrortrap ° true //execute ioerror if true 

J 



and readch(chno) = valof 

c 

1f chno eq -1 do 

[ systemcal l(nil , nil, nil, sysgehar, syserror) 
resultis sysacIO & #377 

let c = 

let err = systemcall((lv c lshift 1) + 1, 1, chno, sysrds, 0) 

test err eq 6 then c = #377 //end-of-f ile error 

or unless err eq -1 do syserror(sysrds, sysac) 

resultis c 

and writech(chno.c) be 

c 

if chno eq -1 do 

[ systemcall(c, nil. nil, syspchar, syserror) 
return 

1 

systemcal 1(( lv c lshift 1) + 1, 1, chno, syswrs, syserror) 
3 

and rcadscq(chno, bptr, nbts) = valof 

[ let err = systemcal l(bptr, nbts, chno, sysrds, 0) 

unless err eq 6 V, err eq -1 do syserror(sysrds , sysac) 

resultis sysacll 
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3 ■ 

ond writcscq(chno, bptr, nbts) be 

C systcmcal1(bptr. nbts, chno, syswrs, syserror) 

3 

and readl ine(chno, string, rdl ) * valof 
C if noargs{ ) Is 3 then rdl a false 

let bptr = (string lshift 1) + 1 

let n, err = , nil 

C err « systcmcall(bptr+n, nil, chno, sysrdl, 0) 

unless err eq 6 % err eq -1 do syserror(sysrdl , sysac) 
n » n + sysacll- (rdl? 0, 1) 

3 repeatwhile (cxtractchar(string, n+1) & #177) eq & not rdl 

n * n + (rdl ? 0. 1) 

str1ng!0 = (n lshirt 8) + (string.'O & #377) 

if err eq 6 & not rdl then n » imbedstr("*n$377", string) 

resultis n * 

3 '. 

end writel inc(chno, string) be 

[if ((stringlO & #177400) eq 0) then return 

systemcall((string lshift 1) + 1, nil, chno, syswrl, syserror) 

3 ■ . . 

and writestr(chno.s ) be 

for 1 = 1 to lcngthstr(s) do C let ch = extractchar(s.i) 
writcch(chno.ch) 

if ch eq S*n then writech(chno,$*l ) 
3 

and writezoct(chno,n) be 
[let zsw = false 

for i = 15 to 3 by -3 do 
X let d = (n rshift i) & #7 
test zsw & (d eq 0) 
then [ writech(chno.S*s) ] 
or [ writech(chno,d+$0); zsw - false ] 

■■ 3 ' • 

writech(chno,(n & #7) + SO) 

■ 3 

and readbin(chno) = valof 

c . 

let w = nil 

systemcall( lv w lshift 1, 2, chno, sysrds, syserror) 

resultis w 

3 

and writebin(chno.w) be 

C 

systemcal 1( lv w lshift 1, 2, chno, syswrs, syserror) 

.3 ■. 

and open(bcplnomc) » valof 

£ if bcplnamc cq resultis -1 " 

if bcplnamc!0 eq resultis -1 

let channel = findchno() 

//if no free channels, system call will give error 
let dosname = vec f ilenomelcngth 

systcmcal,l(dostr(bcplname, dosname), 0, channel, sysopen, syserror) 
resultis channel 
3 

and appcnd(bcplname) = valof 
C if bcplnomc cq resultis -1 
if bcplnamc!0 eq resultis -1 

let channel = findchno() 

let dosname = vec f ilenamelength 

systemcal l(clostr(bcplnnme, dosname), 0, channel, sysappend, syserror) 

resultis channel 

3 ■' . 
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and curposdw(channel ,dw) be 

[ unless le channel & channel le 7 then [ dw!0 = 0; dwll a -1; return ] 
let v ° 0430 //DOS channel table in page one 
let t ° vJchnnnel //DOS descriptor for the channel 
dw!l = t!#25 //word 25 is byte number in current block 
dw!0 a t!#24 //word 24 is current block number 

3 

and curpos(channe1 ) = valof 
[ let dw = vec 2; curposdw( channel , dw) 
resultis ((dw'.O * 255) 1 shift 1) + dw!l 

1 ..■ , '■ . ' ' 

and setpos(ch'annel , pos) be 
C let dw = vec 2 

dw!0 a (pos rshift 1) / 255 //file block number 

dw!l = pos - ((dw!0 * 255) lshift 1) //file bytenumber in last block 

setposdw(channcl , dw) 
3 ■ 

and setposdw(channel ,dw) be 

C unless le channel & channel le 7 return 

let v » #430 

let t = vlchannel 

t!#25 = dw!l //dos byte count in last block 

t!#24 = dwIO 7/dos block count in file 

t!#17 » t!#17 % #4 //set "first write" bit in status word 



// now the dos system cal ls-- 

and systcmcal 1(ac0,acl ,ac2, cal 1 , err) a valof 
[ //generalized dos system call routine. 

//system acs returned in sysac vector, error value through function, 
sysac !0 = acO; sysac !1 = acl; sysac !2= ac2 
let errsw = syscall(call , sysac) 
test errsw cq 
1fso X syscrrorflag = false; resultis -1 ] 
1fnot C 

seterrorpc( ); syserrorflag = true 
syserrorname - acO rshift 1 
syserrorvalue = errsw 

unless (err cq 0) do err(ca!l .sysac) ; resultis errsw ] 
3 . ■-.-•. 

and seterrorpc(arg) be 

[ arg = rv(rv((lv arg) - 6) - #200) - #200 //points to system routine stack 

syserrorpc = rv(arg+2) - 3 

usererrorpc = rv((rv arg) - #200 + 2) - 3 
1 

and ioerror(ca11 ,ac) be .'-._'' 

C let ierr, jerr = syserrorpc, usererrorpc 
let name . err = nil , vec 1 
test noargs( ) eq 1 
1fso [ fl c = sysac: ac!2 = call; err a call;' name a syserrorname 3 
1fnot [ name = ((ac!0) rshift 1); err = ac!2 ] 
1f (not syserrortrap) & noargs( )eq 2 then return 
if sysprin£pc then 

[ writestr( -1 ,"*nsystcm proc="); writeoct(-l ,ierr); 
writcstr( -1 ," user proc ="); writeoct(-l , jerr); 
writcstr(-l,"*n") 

3 
if err eq 1 7, err eq 3 % err eq 4 % err eq #36 then 

C writestr(-l, name); writech(-l,$*s); dosercturn(err) 3 
switchon err into 

[case #11:[ writestr( -1 ."file already exists, file: "); endcase 3 
case #12:[ writestr( -l ,"f ile does not exist, file: "); endcase ] 
case #13:[ writestr(-l ."attempt to alter a permanent file: "); endcase 3 
default:[ dosereturn(err ) ] 

3' 
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writestr(-l.name); writestr(-l,"*n"); dosreturn() 

^ '. 

and noargs(arg) = rv(rv((lv arg) - 6) - #200 + 5) 

// back to the last frame to the number of args 

and f indchno( ) =» valof 
lot v = #430 
for 1 a o to 7 do if (v!1 & #100000) ne do resultls 1 
resultis #100000 

and createf ile(nnme) be 

lot dosnnmc = vec f ilenamelength 
systemcal 1(dostr(namc, dosname), nil, nil, syscreatc, syserror) 

and dcletef ile(name) be 

let dosname = yec fil enamel ength 
let err = systcmcall(dostr(name,. dosname), nil, .nil, sysdelete, 0) 
unless (err cq #12) % (err eq -1) do syserror(sysdelete.sysac) 

and initdev(nnme) be 

let dosnnme = vec f Ilenamelength 
systemcal l(dostr(name, dosname), 0, nil, sysinlt, syserror) 

and directorydev(name) be 

let dosname = vec f ilenamelength . 
systemcal l(clostr(name, dosname), nil , nil, sysdlr, syserror) 

and releasedev(name) be 

let dosname = vec f ilenamelength 
systemcall(dostr(name, dosname), nil, nil, sysrlse, syserror) 

and renamcf ilc(name,newname) be 

let newdosname = vec f ilenamelength 

let dosname = vec f ilenamelength 

systemcal l(dostr(name, dosname), dostr(newname, newdosname), nil, sysrename, syserror) 

and close(chno). be 

systemcal 1(ml , nil, chno, sysclose, syserror) 

and resetf iles( ) be 

systemcal l(nil , nil, nil , sysreset, syserror) 

and install (channel ) be 

systemcal 1 (channel , nil, nil, syslnst, syserror) 

and chatr(chno.acO) be 
ystemcall(acO, nil, chno, syschatr, syserror) 

and gctf ilcatr(chno) = valof 

systemcal l(nil , nil, chno, sysgtatr, syserror) 
resultis s"ysac!0 

and mcmavail() = valof 

systemcal 1 (nil • nil, nil, sysmem, syserror). 
resultis sysacIO - sysacll 

and memincr( incr) = valof 

systemcal 1( iricr, nil, nil, sysmemi, syserror) 
resultis sysacll 
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3 

and dosexec(nnme, acl) be 

C let dosname = vec f ilenamelength 

systemcal 1(dostr(name, dosname), (noargs() eq 2? acl, 0), nil, sysexec, syserror) 
] 

and dosrcturn( ) be 

[ systemcall(nil , nil, nil, sysrtn, syserror) 

3 

and dosereturn(ac2) be 

[ systemcal 1 ( ni 1 , nil, 'nil, sysertn, syserror) 

3 

and dosbrcak( ) be 

[ systemcall(nil , nil', nil, sysbreak, syserror) * 

// now the string procedures necessary for io-\runt1me 

and lengthstr(s) = s!0 rshift 8 

and imbedstr(sl ,s2,i ) = valof 

//if i is larger than length of s2, si is still inserted 
//and blanks are filled in empty space. 
//if i is not specified, ch is appended. 

[ let lsl, ls2 = sl!0 rshift 8, s2!0 rshift 8 
1f noargs( ) eq 2 then i = ls2 + 1 
1f (lsl + i) gr 255 then lsl = 255-ls2 
1f (i le ) % (i gr 255) then resultis 0. 

[ let t = i+lsl-ls2-l; if t gr then s2!0 ■ s210 + (t lshift 8) 3 
let bent = i - ls2 - 1 
1f bent gr then [ let wls2 = ls2 rshift 1; 

if (ls2 & 1) eq then [ s2!wls2 « (s2!wls2 & #177400)+#40 

bent = bent - 1 ] 
for 1 " i'to (bcnt+1) rshift 1 do s2!(.i+wls2) = #20040 

•<•■•• .-3 

..•lei mfb » ((lsl+i)il) eq 1 

let w1, wlsl = 1 rshift 1, lsl rshirt 1 

let bdry = true 

//move first byte if i is odd to get on a word bdry of dest 

1f (i&l) eq 1 then [ s2!wi = (s2!wi & #177400) + (sl!0 & #377) 
1=1+1; wi»wi+l; 
bdry = false ] 

// now do the word moves 

for j « 1 to wlsl do [ s2!wi = bdry ? 

(sl!(j-l) lshift 8) + (sl!j rshift 8), sllj 
wi*wi+l ] 

// now check for the final byte 

if mfb then s2!wi = (s2!wi&#377) + 

•^ ((lsl&l) eq 1 ? sllwlsl lshift 8, 
sllwlsl & #177400) 
. Is2 = s2!0 rshift 8; let wls2 = ls2 rshift 1 
if (ls2 & 1) eq then s2!wls2 = ( s2!wl s2)&#177400 
resultis (wi lshift 1) + (mfb ? 1. 0) 

and imbedchar(ch,sl ,i ) = valof 

//if i is larger than length. of si, ch is still inserted 
//and blanks are filled in empty space. 
//if i 1s not specified, ch is appended. 

C let s ■. vec 1; s!0 = #400 + ch 



test noargs() Is 3 then resultls imbedstr(s,sl) or resultis imbedstr(s,sl,1) 

and movestr(pl. p2) be 

C 

if pi eq p2 then return 

let n » pl!0 rshift 8 

test n eq 

then n » pl!0 

or n ■ n/2 

for 1 « to n do p2!i » plM 

and dostr(bn.dn) = valof [ 
movestr(bn.dn) 
imbcdstr("*000'\dn) 
resultls (dn Ishift 1) + 1 

3 ' 

and extractchar(s.i ) a ((i&l) eq 1) ? 

(s!(1 rshift 1) & #377). (s 1(1 rshift 1) rshift 8) 
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let searchstr(sl ,s2,1x) = valof 

C 

let 1sl,ls2 = sl!0 rshlft 8, s2!0 rshirt 8 

let ch2 - s2!0 & #377 

let streq » false 

let k.wls2.kbit * nil .( Is2-1 ) rshift l.nil 

for 1 ■ ((noargs( ) eq 3)&(ix gr 0)? ix, 1) to lsl-ls2+l do 

[1 1f ch2 eq (((i&l) eq 1) ? (sl!(i rshift 1) &#377), (sll(1 rshlft 1) rshlft 8)) 
then [2 

kbit = (i+1) & 1; k = (i+1) rshlft 1; streq « true 
for j » 1 to wls2 do 
C3 

unless (s2!j eq ((kbit ? 

((sl!k lshift 8) + (sl!(k+l) rshirt 8)), 
(silk)))) 
do [ streq » false; break ] 
k » k + 1 

3 3 

1f streq & ((ls2&l) eq 0) then 

1f (s2!(wls2+l) & #177400) 

eq (kbit ? ((silk) lshift 8), 

((silk) & #177400)) 
then resultis i 
32 
1f streq then resultis i 

resultis // exit here if no match is found. 

3 . . 

and extractstr(sl , s2, i, lsl) '*> valof 

C let ls2 = s2!0 rshift 8 

if noargs() eq 3 then lsl » sl!0 rshift 8 

if lsl eq then C sl!0 - 0; resultis ] 

1f lsl gr (ls2-i+l) then lsl = ls2 - i + 1 

let k. kbit, wlsl = (i+1) rshift 1, (i+1) & 1, (lsl -. 1) rshirt 1 

sl!0 = (lsl lshift 8) + 

(((i&l) eq l)?(s2!(i rshift 1) & #377), (s2!(i rshift 1) rshift 8)) 

for j = 1 to wlsl do 

[1 sl!j = kbit ? (s2!k lshift 8) + (s2!(k+l) rshift 8), s2!k 
k ■ k + 1 

31 
if ((lsl & 1) eq ) then sl!(wlsl + 1) = kbit ? 

s2!k lshift 8, s2!k & #177400 . 

resultis lsl 
3 

.and strtovalue(name ( rdx) -a valof 

C //get number from string in radix rdx, default is 8 
if noargs(J eq 1 then rdx =8 
let n,s, minus = 0, nil, false 
for i * 1 to lcngthstr(name) do 

[ s = extractchar(name,i ) & #177 

if s eq $- then [ minus = true; loop] 

s = s - $0 

if le s & s le rdx-1 do 

n * n*rdx + s 

3 
resultis minus?-n, n 

3 

and packstr(u, p) be 
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let n = u!0 

let 1, j = 0. 

C p! j B u!i 1 shift 8 

1 « 1 + 1; lf'1 gr n return 

plj = plj + (u!i & #377) 

1*1+1; Ifigrn return 

d - J + 1 
3 repeat 

3 

and unpackstr(p, u) be 

C 

let n ■ p!0 rshif t 8 
let 1, j = 0, 
C uH = p!j rshift 8 
■ 1 ■ ■ 1 + 1 : 1f 1 gr. n return 
u!1 » p!j & #377 
1-1+1; If i gr n return 
i « + 1 
] repeat 
3 

and valuctostr(w, s, rdx, sp) be 

[ let spc « (noargs() eq 4) & (sp gr 0) 

let min - w Is ^ i , . ^ « 

let getdigt(w, s. rdx, sp, min, spc) = valof 
[ let j = w; w = w/rdx; sp = sp-1 
test w nc 

ifso imbedchar(getdigt(w, s, rdx, sp, min, spc), s) 
ifnot [ test min 

ifso imtfedstr("-'\ s, (spc?sp,l)) 
ifnot if spc then imbedstr(" ", s, sp) 

3 
resultis SO + (min? -j+w*rdx, j-w*rdx) 

3 
1mbedchar(getdigt(w, s, rdx, sp, min, spc),s) 

3 

and writcvaluc(chno, w, rdx, sp) be 
[if noar'gs(') Is 4 then sp ■ 

let s a vec 10 

valuetostr(w, s, rdx, sp) 

writestr(chno, s) 

3 

and writedcc(chno, w, sp) be 
C if noargs() Is 3 then sp = 

writevaluc(chno, w, 10, sp) 
3 

and writcoct(chno, w, sp) be 
[ if noargs() Is 3 then sp = 
writevalue(chno, w, 8, sp) 

3 

and writeform(chno, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, 
nil, nil, nil, nil, nil, nil. nil, nil) be 
Z let arg = 1 v chno 

for i = 1 Xo noargs( )-l by 2 do 

[ if org!i Is % arg!i gr 10 loop 
test (arg! i ) eq 

ifso writestr(chno, arg!(i+l)) 

ifnot writevalue(chno, arg!(i+l), argil) 

3 
3 
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